open Gnsyn
open String
open List
open Str

let output_width = 50

let rec string_of_gnvalue vl =
	match vl with 
		  R(f)		-> string_of_float(f)
		| I(i)		-> string_of_gnint(i)
		| B(b)		-> if b then "#t" else "#f"
		| Ch(s)		-> ("'" ^ (String.make 1 s) ^ "'")
		| F(vars,typ,exp,_)
			-> ((string_of_stringlist vars) ^ " => " ^ (string_of_gnexp exp))
		| PF(func)
			-> "... -> ..."
		| N		-> "()"
		| C(ca,cd)	-> string_of_cons vl
		| Type_Error(s)	-> (s)
and string_of_gnint i = 
	match i with 
		  IVal(iv) -> string_of_int(iv)
		| INaN     -> "nan"
and fold_string_infix sym empty lst = 
	match lst with
		  x::[] -> x
		| x::xs -> (x ^ sym ^ (fold_string_infix sym empty xs))
		| []    -> empty
and string_of_vallist vals = fold_string_infix " * " "" (map string_of_gnvalue vals)
and string_of_stringlist lst = fold_string_infix " * " "()" lst
and string_of_cons cons =
	if is_list cons then
		if is_string cons then
			make_string_string cons
		else make_list_string cons
	else match cons with 
		  C(ca, cd)	-> ("("^(string_of_gnvalue ca) ^ " . " ^(string_of_gnvalue cd)^")")
		| _		-> "Unexpected argument to string_of_cons"
and string_of_tup lst = fold_string_infix ", " "" (map string_of_gnvalue lst)
and is_list cons =
	match cons with
		  N		-> true
		| C(ca, cd)	-> is_list cd
		| _		-> false
and is_string cons = 
	match cons with
		  C(Ch(_),N)	-> true
		| C(Ch(_),cd)	-> is_string cd
		| _		-> false
and make_string_string cons = 
	match cons with
		  C(Ch(s),N)	-> (String.make 1 s)
		| C(Ch(s),cd)	-> ((String.make 1 s) ^ (make_string_string cd))
		| _		-> "Unexpected argument to make_string_string"
and make_list_string lst = 
	let rec pplh cons = 
		match cons with
			  N		-> ""
			| C(ch,N)	-> string_of_gnvalue ch
			| C(ch,cd)	-> ((string_of_gnvalue ch) ^ ", " ^ (pplh cd))
			| _		-> "Unexpected argument to make_list_string"
	in ("[" ^ (pplh lst) ^ "]")
and string_of_gnexp vl = 
	match vl with 
		  Real(f)		-> string_of_float(f)
		| Integer(i)		-> string_of_int(i)
		| Boolean(b)		-> string_of_bool(b)
		| Char(s)		-> ("'" ^ (String.make 1 s) ^ "'")
		| Identifier(s)		-> s
		| Nil			-> "nil"
		| Lambda(vars,Arrow_Type(vt,rt),exp)
			-> ((string_of_declist (vars,vt)) ^ " -> " ^ (string_of_gntype rt) ^ " => " ^ (string_of_gnexp exp))
		| Lambda(vars,_,exp)	-> ((string_of_stringlist vars) ^ " => " ^ (string_of_gnexp exp))
		| Application(exp1,exp2)-> ("(" ^ (string_of_gnexp exp1) ^ " " ^ (string_of_gnexplist exp2) ^ ")") 
		| Let(terms,bdy)	-> ((string_of_assigns terms ":=") ^ ", " ^ (string_of_gnexp bdy))
		| Commit(terms) 	-> (string_of_assigns terms "<-")
		| Sequence(ca,cd)	-> ("((" ^ (string_of_gnexp ca) ^ ") | (" ^ (string_of_gnexp cd)^"))") 
		| Conditional(q,t,f,ck)	-> ((if ck then "IF" else "IF*") ^ (string_of_gnexp q) ^ " THEN " ^ (string_of_gnexp t) ^ " ELSE " 
					    ^ (string_of_gnexp f) ^ " ENDIF")
		| Match(m,c,d,ck)	-> ((if ck then "MATCH " else "MATCH* ") ^ (string_of_gnexp m) ^ " WITH " ^ (string_of_matchcases c) ^ " | ELSE => " 
					    ^ (string_of_gnexp d) ^ " ENDMATCH")
and string_of_gnexplist lst = fold_string_infix " " "" (map string_of_gnexp lst)
and string_of_assigns lst sym = fold_string_infix " & " "" 
	(map (fun ((id, tau), body) -> (id ^ ":" ^ (string_of_gntype tau) ^ " " ^ sym ^ " " ^ (string_of_gnexp body))) lst)
and string_of_matchcases lst = fold_string_infix " | " "" (map (fun (case,exp) -> ((string_of_cases case) ^ " => " ^ (string_of_gnexp exp))) lst)
and string_of_cases cases = fold_string_infix "::" "" cases 
and string_of_gntype tau =
	match tau with
		  Basic_Type(typ)	-> typ
		| Product_Type(typs)	-> "[" ^ (string_of_typelist typs) ^ "]"
		| Arrow_Type(pt, rt)	-> "[" ^ (string_of_typelist pt) ^ " -> " ^ (string_of_gntype rt) ^ "]"
		| List_Type(rt)		-> string_of_listtype rt
		| Dynamic_Type		-> "Dynamic"
		| Type_Variable(s)	-> s
		| Exclusive_Type_Variable(s, _)
			-> s
		| Static_Type_Error(s)	-> (s)
and string_of_typelist typs = fold_string_infix " * " "" (map string_of_gntype typs)
and string_of_declist decs = 
	let deca, decb = decs
	in fold_string_infix " * " "" (map (fun (v,t) -> (v ^ ":" ^ (string_of_gntype t))) (combine deca decb))
and string_of_listtype lt =
	match lt with
		  Empty_List 	-> "[]"
		| List(rt)	-> "[" ^ (string_of_gntype rt) ^ "]"

let gag = ref false

let rec fixwidth str fst = 
	let len = String.length str
	in let off = if fst then output_width+8 else output_width
	in if len > off then ((String.sub str 0 off) ^ "\n\t\t" ^ (fixwidth (String.sub str off (len-off)) false)) else str
and print_fix str = 
	if not !(gag) then (
		print_string str;
	        flush stdout
	)
